home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / src / tclXbsearch.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-19  |  10.6 KB  |  358 lines
  1. /*
  2.  * tclXbsearch.c
  3.  *
  4.  * Extended Tcl binary file search command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXbsearch.c,v 3.0 1993/11/19 06:58:20 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Control block used to pass data used by the binary search routines.
  23.  */
  24. typedef struct binSearchCB_t {
  25.     Tcl_Interp   *interp;         /* Pointer to the interpreter.             */
  26.     char         *fileHandle;     /* Handle of file.                         */
  27.     char         *key;            /* The key to search for.                  */
  28.  
  29.     FILE         *fileCBPtr;      /* Open file structure.                    */
  30.     Tcl_DString   dynBuf;         /* Dynamic buffer to hold a line of file.  */
  31.     long          lastRecOffset;  /* Offset of last record read.             */
  32.     int           cmpResult;      /* -1, 0 or 1 result of string compare.    */
  33.     char         *tclProc;        /* Name of Tcl comparsion proc, or NULL.   */
  34.     } binSearchCB_t;
  35.  
  36. /*
  37.  * Prototypes of internal functions.
  38.  */
  39. static int
  40. StandardKeyCompare _ANSI_ARGS_((char *key,
  41.                                 char *line));
  42.  
  43. static int
  44. TclProcKeyCompare _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  45.  
  46. static int
  47. ReadAndCompare _ANSI_ARGS_((long           fileOffset,
  48.                             binSearchCB_t *searchCBPtr));
  49.  
  50. static int
  51. BinSearch _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  52.  
  53. /*
  54.  *-----------------------------------------------------------------------------
  55.  *
  56.  * StandardKeyCompare --
  57.  *    Standard comparison routine for BinSearch, compares the key to the
  58.  *    first white-space seperated field in the line.
  59.  *
  60.  * Parameters:
  61.  *   o key (I) - The key to search for.
  62.  *   o line (I) - The line to compare the key to.
  63.  *
  64.  * Results:
  65.  *   o < 0 if key < line-key
  66.  *   o = 0 if key == line-key
  67.  *   o > 0 if key > line-key.
  68.  *-----------------------------------------------------------------------------
  69.  */
  70. static int
  71. StandardKeyCompare (key, line)
  72.     char *key;
  73.     char *line;
  74. {
  75.     int  cmpResult, fieldLen;
  76.     char saveChar;
  77.  
  78.     fieldLen = strcspn (line, " \t\r\n\v\f");
  79.  
  80.     saveChar = line [fieldLen];
  81.     line [fieldLen] = 0;
  82.     cmpResult = strcmp (key, line);
  83.     line [fieldLen] = saveChar;
  84.  
  85.     return cmpResult;
  86. }
  87.  
  88. /*
  89.  *-----------------------------------------------------------------------------
  90.  *
  91.  * TclProcKeyCompare --
  92.  *    Comparison routine for BinSearch that runs a Tcl procedure to, 
  93.  *    compare the key to a line from the file.
  94.  *
  95.  * Parameters:
  96.  *   o searchCBPtr (I/O) - The search control block, the line should be in
  97.  *     dynBuf, the comparsion result is returned in cmpResult.
  98.  *
  99.  * Results:
  100.  *   TCL_OK or TCL_ERROR.
  101.  *-----------------------------------------------------------------------------
  102.  */
  103. static int
  104. TclProcKeyCompare (searchCBPtr)
  105.     binSearchCB_t *searchCBPtr;
  106. {
  107.     char *cmdArgv [3], *command, *oldResult;
  108.     int   result;
  109.  
  110.     cmdArgv [0] = searchCBPtr->tclProc;
  111.     cmdArgv [1] = searchCBPtr->key;
  112.     cmdArgv [2] = searchCBPtr->dynBuf.string;
  113.     command = Tcl_Merge (3, cmdArgv);
  114.  
  115.     result = Tcl_Eval (searchCBPtr->interp, command);
  116.  
  117.     ckfree (command);
  118.     if (result == TCL_ERROR)
  119.         return TCL_ERROR;
  120.  
  121.     if (!Tcl_StrToInt (searchCBPtr->interp->result, 0, 
  122.                        &searchCBPtr->cmpResult)) {
  123.         oldResult = ckstrdup (searchCBPtr->interp->result);
  124.  
  125.         Tcl_ResetResult (searchCBPtr->interp);
  126.         Tcl_AppendResult (searchCBPtr->interp, "invalid integer \"", oldResult,
  127.                           "\" returned from compare proc \"",
  128.                           searchCBPtr->tclProc, "\"", (char *) NULL);
  129.         ckfree (oldResult);
  130.         return TCL_ERROR;
  131.     }
  132.     Tcl_ResetResult (searchCBPtr->interp);
  133.     return TCL_OK;
  134. }
  135.  
  136. /*
  137.  *-----------------------------------------------------------------------------
  138.  *
  139.  * ReadAndCompare --
  140.  *    Search for the next line in the file starting at the specified
  141.  *    offset.  Read the line into the dynamic buffer and compare it to
  142.  *    the key using the specified comparison method.  The start of the
  143.  *    last line read is saved in the control block, and if the start of
  144.  *    the same line is found in the search, then it will not be recompared.
  145.  *    This is needed since the search algorithm has to hit the same line
  146.  *    a couple of times before failing, due to the fact that the records are
  147.  *    not fixed length.
  148.  *
  149.  * Parameters:
  150.  *   o fileOffset (I) - The offset of the next byte of the search, not
  151.  *     necessarly the start of a record.
  152.  *   o searchCBPtr (I/O) - The search control block, the comparsion result
  153.  *     is returned in cmpResult.  If the EOF is hit, a less-than result is
  154.  *     returned.
  155.  *
  156.  * Results:
  157.  *   TCL_OK or TCL_ERROR.
  158.  *-----------------------------------------------------------------------------
  159.  */
  160. static int
  161. ReadAndCompare (fileOffset, searchCBPtr)
  162.     long           fileOffset;
  163.     binSearchCB_t *searchCBPtr;
  164. {
  165.     int  recChar, status;
  166.  
  167.     if (fseek (searchCBPtr->fileCBPtr, fileOffset, SEEK_SET) != 0)
  168.         goto unixError;
  169.  
  170.     /*
  171.      * Go to beginning of next line.
  172.      */
  173.     
  174.     if (fileOffset != 0) {
  175.         while (((recChar = getc (searchCBPtr->fileCBPtr)) != EOF) &&
  176.                 (recChar != '\n'))
  177.             fileOffset++;
  178.         if ((recChar == EOF) && ferror (searchCBPtr->fileCBPtr))
  179.             goto unixError;
  180.     }
  181.     /*
  182.      * If this is the same line as before, then just leave the comparison
  183.      * result unchanged.
  184.      */
  185.     if (fileOffset == searchCBPtr->lastRecOffset)
  186.         return TCL_OK;
  187.  
  188.     searchCBPtr->lastRecOffset = fileOffset;
  189.  
  190.     Tcl_DStringFree (&searchCBPtr->dynBuf);
  191.  
  192.     status = Tcl_DStringGets (searchCBPtr->fileCBPtr,
  193.                               &searchCBPtr->dynBuf);
  194.     if (status == TCL_ERROR)
  195.         goto unixError;
  196.  
  197.     /* 
  198.      * Only compare if EOF was not hit, otherwise, treat as if we went
  199.      * above the key we are looking for.
  200.      */
  201.     if (status == TCL_BREAK) {
  202.         searchCBPtr->cmpResult = -1;
  203.         return TCL_OK;
  204.     }
  205.  
  206.     if (searchCBPtr->tclProc == NULL) {
  207.         searchCBPtr->cmpResult = StandardKeyCompare (searchCBPtr->key, 
  208.                                                      searchCBPtr->dynBuf.string);
  209.     } else {
  210.         if (TclProcKeyCompare (searchCBPtr) != TCL_OK)
  211.             return TCL_ERROR;
  212.     }
  213.  
  214.     return TCL_OK;
  215.  
  216. unixError:
  217.    Tcl_AppendResult (searchCBPtr->interp, searchCBPtr->fileHandle, ": ",
  218.                      Tcl_PosixError (searchCBPtr->interp), (char *) NULL);
  219.    return TCL_ERROR;
  220. }
  221.  
  222. /*
  223.  *-----------------------------------------------------------------------------
  224.  *
  225.  * BinSearch --
  226.  *      Binary search a sorted ASCII file.
  227.  *
  228.  * Parameters:
  229.  *   o searchCBPtr (I/O) - The search control block, if the line is found,
  230.  *     it is returned in dynBuf.
  231.  * Results:
  232.  *     TCL_OK - If the key was found.
  233.  *     TCL_BREAK - If it was not found.
  234.  *     TCL_ERROR - If there was an error.
  235.  *
  236.  * based on getpath.c from smail 2.5 (9/15/87)
  237.  *
  238.  *-----------------------------------------------------------------------------
  239.  */
  240. static int
  241. BinSearch (searchCBPtr)
  242.     binSearchCB_t *searchCBPtr;
  243. {
  244.     FILE       *filePtr;
  245.     long        middle, high, low;
  246.     struct stat statBuf;
  247.  
  248.     if (Tcl_GetOpenFile (searchCBPtr->interp, searchCBPtr->fileHandle,
  249.                          FALSE,  /* Read access  */
  250.                          TRUE,   /* Check access */
  251.                         &filePtr) != TCL_OK)
  252.         return TCL_ERROR;
  253.  
  254.     searchCBPtr->fileCBPtr = filePtr;
  255.     searchCBPtr->lastRecOffset = -1;
  256.  
  257.     if (fstat (fileno (searchCBPtr->fileCBPtr), &statBuf) < 0)
  258.         goto unixError;
  259.  
  260.     low = 0;
  261.     high = statBuf.st_size;
  262.  
  263.     /*
  264.      * "Binary search routines are never written right the first time around."
  265.      * - Robert G. Sheldon.
  266.      */
  267.  
  268.     while (TRUE) {
  269.         middle = (high + low + 1) / 2;
  270.  
  271.         if (ReadAndCompare (middle, searchCBPtr) != TCL_OK)
  272.             return TCL_ERROR;
  273.  
  274.         if (searchCBPtr->cmpResult == 0)
  275.             return TCL_OK;     /* Found   */
  276.         
  277.         if (low >= middle)  
  278.             return TCL_BREAK;  /* Failure */
  279.  
  280.         /*
  281.          * Close window.
  282.          */
  283.         if (searchCBPtr->cmpResult > 0) {
  284.             low = middle;
  285.         } else {
  286.             high = middle - 1;
  287.         }
  288.     }
  289.  
  290. unixError:
  291.    Tcl_AppendResult (searchCBPtr->interp, searchCBPtr->fileHandle, ": ",
  292.                      Tcl_PosixError (searchCBPtr->interp), (char *) NULL);
  293.    return TCL_ERROR;
  294. }
  295.  
  296. /*
  297.  *-----------------------------------------------------------------------------
  298.  *
  299.  * Tcl_BsearchCmd --
  300.  *     Implements the TCL bsearch command:
  301.  *        bsearch filehandle key ?retvar?
  302.  *
  303.  * Results:
  304.  *      Standard TCL results.
  305.  *
  306.  *-----------------------------------------------------------------------------
  307.  */
  308. int
  309. Tcl_BsearchCmd (clientData, interp, argc, argv)
  310.     ClientData  clientData;
  311.     Tcl_Interp *interp;
  312.     int         argc;
  313.     char      **argv;
  314. {
  315.     int           status;
  316.     binSearchCB_t searchCB;
  317.  
  318.     if ((argc < 3) || (argc > 5)) {
  319.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  320.                           " handle key ?retvar? ?compare_proc?"
  321.                           , (char *) NULL);
  322.         return TCL_ERROR;
  323.     }
  324.  
  325.     searchCB.interp = interp;
  326.     searchCB.fileHandle = argv [1];
  327.     searchCB.key = argv [2];
  328.     searchCB.tclProc = (argc == 5) ? argv [4] : NULL;
  329.     Tcl_DStringInit (&searchCB.dynBuf);
  330.  
  331.     status = BinSearch (&searchCB);
  332.     if (status == TCL_ERROR) {
  333.         Tcl_DStringFree (&searchCB.dynBuf);
  334.         return TCL_ERROR;
  335.     }
  336.  
  337.     if (status == TCL_BREAK) {
  338.         Tcl_DStringFree (&searchCB.dynBuf);
  339.         if ((argc >= 4) && (argv [3][0] != '\0'))
  340.             interp->result = "0";
  341.         return TCL_OK;
  342.     }
  343.  
  344.     if ((argc == 3) || (argv [3][0] == '\0')) {
  345.         Tcl_DStringResult (interp, &searchCB.dynBuf);
  346.     } else {
  347.         char *varPtr;
  348.  
  349.         varPtr = Tcl_SetVar (interp, argv[3], searchCB.dynBuf.string,
  350.                              TCL_LEAVE_ERR_MSG);
  351.         Tcl_DStringFree (&searchCB.dynBuf);
  352.         if (varPtr == NULL)
  353.             return TCL_ERROR;
  354.         interp->result = "1";
  355.     }
  356.     return TCL_OK;
  357. }
  358.